unit SLV ;

interface

uses
   Windows,
   Classes,
   Contnrs,
   SysUtils,
   SLVTypes ;

type

   TSigForm = ( stNone, stBit, stVector, stSignal, stBundle ) ;

   TSLVTable = array[ TSLVType, TSLVType ] of TSLVType ;
   TSLVVec = array[ TSLVType ] of TSLVType ;

   EBitsError = class( Exception ) ;

   PSLVArray = ^TSLVArray ;
   TSLVArray = array[ 0..32767 ] of TSLVType ;

   TQueue = class
   private
      fItems : array of PSLVArray ;
      fIn, fOut, fWidth, fCapacity : integer ;

      function GetItems( index : integer ) : PSLVArray ;
      procedure SetCapacity( const Value : integer ) ;
      function GetCapacity : integer ;
      function GetCount : integer ;
      function Add( aWidth : integer ) : PSLVArray ;
   public
      constructor Create( aWidth : integer ) ;
      destructor Destroy ; override ;
      procedure Clear ;

      property Items[ index : integer ] : PSLVArray read GetItems ; default ;
      property Capacity : integer read GetCapacity write SetCapacity ;
      property Count : integer read GetCount ;
   end ;

   TSLVVisitor = class ;

   TSLVClass = class
   private
   public
      function Accept( Visitor : TSLVVisitor ) : TObject ; virtual ; abstract ;
   end ;

   TSLVSignal = class( TSLVClass )
   private
      fBits : TQueue ;
      fWidth : integer ;
      function GetBit( Cursor, Index : Integer ) : TSLVType ;
      function GetRight : Integer ;
      function GetValue( Cursor : Integer ) : PSLVArray ;
      function GetCapacity : integer ;
      procedure SetCapacity( const Value : integer ) ;
      function GetName : string ;
      function GetPath : string ;
      function GetLeft : Integer ;
   public
      constructor Create( aWidth : integer ) ;
      destructor Destroy ; override ;

      procedure Reset ;
      function Accept( Visitor : TSLVVisitor ) : TObject ; override ;
      property Name : string read GetName ;
      property Path : string read GetPath ;
      property Width : Integer read fWidth ;
      property Oldest : Integer read GetLeft ;
      property Newest : Integer read GetRight ;

      property Bits[ Cursor, Index : Integer ] : TSLVType read GetBit ; default ;
      property Capacity : integer read GetCapacity write SetCapacity ;

      property Value[ Cursor : Integer ] : PSLVArray read GetValue ;
      function BitAsString( Cursor : integer ; Index : Integer ) : string ;
      function AsString( Cursor : integer ) : string ;
      function AsHexString( Cursor : integer ) : string ;

      procedure Add( const aValue : array of TSLVType ) ; overload ;
//      procedure Add( const aSignal : TSignal ) ; overload ;
//      procedure Add( const aVector : TVector ) ; overload ;
      procedure Acquire ; virtual ;
   end ;

   TSLVBundle = class( TSLVClass )
   private
      fName : string ;
      fSignals : TObjectList ;
      function GetCount : Integer ;
      function GetSignal( Index : integer ) : TSLVSignal ;
      procedure SetSignal( Index : integer ; const Value : TSLVSignal ) ;
      function GetLeft : Integer ;
      function GetRight : Integer ;
      function GetSpan : DWORD ;
      function GetCapacity : integer ;
      procedure SetCapacity( const Value : integer ) ;
   public
      constructor Create ;
      destructor Destroy ; override ;
      procedure Clear ; virtual ;
      procedure Reset ; virtual ;
      function Accept( Visitor : TSLVVisitor ) : TObject ; override ;
      property Name : string read fName write fName ;
      property Signals[ Index : integer ] : TSLVSignal read GetSignal write SetSignal ; default ;
      procedure AddSignal( signal : TSLVSignal ) ;
      function Add( aWidth : integer ) : TSLVSignal ;
      property Count : Integer read GetCount ;
      property Oldest : Integer read GetLeft ;
      property Newest : Integer read GetRight ;
      property Span : DWORD read GetSpan ;
      property Capacity : integer read GetCapacity write SetCapacity ;
      procedure Acquire ; virtual ;
   end ;

   TSLVVisitor = class
   public
      function Visit( Instance : TSLVClass ) : TObject ; overload ; virtual ; abstract ;
      function Visit( Instance : TSLVSignal ) : TObject ; overload ; virtual ; abstract ;
      function Visit( Instance : TSLVBundle ) : TObject ; overload ; virtual ; abstract ;
   end ;

   TNotifySimEvent = procedure( aRoot : TSLVBundle ; aCenter : integer ) of object ;

function SLVToStr( a : TSLVType ) : string ;

implementation

{function slvAND( a, b : TSLVType ) : TSLVType ;
const
    and_table   : TslvTable = (
        ( slvU, slvU, slv0, slvU ),
        ( slvU, slvU, slv0, slvU ),
        ( slv0, slv0, slv0, slv0 ),
        ( slvU, slvU, slv0, slv1 )
        ) ;
begin
    Result := and_table[ a, b ] ;
end ;

function slvWOR( a, b : TSLVType ) : TSLVType ;
const
    resolution_table : TslvTable = (
        //----------------------------------
        //  U     X     0     1        |   |
        //----------------------------------
        ( slvU, slvU, slv0, slvU ),                         // | U |
        ( slvU, slvU, slv0, slvU ),                         // | X |
        ( slv0, slv0, slv0, slv0 ),                         // | 0 |
        ( slvU, slvU, slv0, slv1 )                          // | 1 |
        ) ;
begin
    Result := resolution_table[ a, b ] ;
end ;

function slvOR( a, b : TSLVType ) : TSLVType ;
const
    or_table    : TslvTable = (
        ( slvU, slvU, slvU, slv1 ),
        ( slvU, slvU, slvU, slv1 ),
        ( slvU, slvU, slv0, slv1 ),
        ( slv1, slv1, slv1, slv1 )
        ) ;
begin
    Result := or_table[ a, b ] ;
end ;

function slvXOR( a, b : TSLVType ) : TSLVType ;
const
    xor_table   : TslvTable = (
        ( slvU, slvU, slvU, slvU ),
        ( slvU, slvU, slvU, slvU ),
        ( slvU, slvU, slv0, slv1 ),
        ( slvU, slvU, slv1, slv0 )
        ) ;
begin
    Result := xor_table[ a, b ] ;
end ;

function slvNOT( a : TSLVType ) : TSLVType ;
const
    not_table   : TSLVVec =
        ( slvU, slvU, slv1, slv0 ) ;
    //        ( slvU, slvX, slv1, slv0, slvX, slvX, slv1, slv0, slvX ) ;
begin
    Result := not_table[ a ] ;
end ;
}

function SLVToStr( a : TSLVType ) : string ;
const
   slvTxt : array[ TSLVType ] of char = (
      '0', // Forcing 0
      '1', // Forcing 1
      'L', // Weak 0
      'H', // Weak 1

      'C', '?', '?', 'X', '?', '?', '?', '?',

      '-', // Don't care
      'Z', // High Impedance
      'W', // Weak Unknown
      'U' // Uninitialized
      ) ;
begin
   Result := slvTxt[ a ] ;
end ;

{ TSLVSignal }

constructor TSLVSignal.Create( aWidth : integer ) ;
begin
   fWidth := aWidth ;
   fBits := TQueue.Create( aWidth ) ;
   fBits.Capacity := 100 ;
   Reset ;
end ;

destructor TSLVSignal.Destroy ;
begin
   fBits.Free ;
   inherited ;
end ;

procedure TSLVSignal.Reset ;
begin
   fBits.Clear ;
end ;

function TSLVSignal.GetBit( Cursor, Index : Integer ) : TSLVType ;
begin
   Result := slvU ;
   if fBits.Count > 0 then
      Result := fBits[ Cursor ][ Index ] ;
end ;

function TSLVSignal.GetValue( Cursor : Integer ) : PSLVArray ;
begin
   Result := nil ;
   if fBits.Count > 0 then
      Result := fBits[ Cursor ] ;
end ;

function TSLVSignal.AsString( Cursor : integer ) : string ;
var
   i : integer ;
begin
   Result := '' ;
   for i := 0 to Width - 1 do
      Result := SLVToStr( Bits[ Cursor, i ] ) + Result ;
end ;

function TSLVSignal.AsHexString( Cursor : integer ) : string ;
var
   i : integer ;
   h : integer ;

   procedure AddH ;
   begin
      if h < 0 then
         Result := 'U' + Result
      else
         Result := IntToHex( h, 1 ) + Result ;
      h := 0 ;
   end ;
begin
   Result := '' ;
   h := 0 ;
   i := 0 ;
   while i < Width + ( 4 - Width mod 4 ) mod 4 do begin
      h := h shr 1 ;
      if i < Width then
         case Bits[ Cursor, i ] of
            slv0 : ;
            slv1 : h := h or 8 ;
         else
            h := h or -1 ;
         end ;
      if i mod 4 = 3 then
         AddH ;
      inc( i ) ;
   end ;
end ;

function TSLVSignal.BitAsString( Cursor, Index : Integer ) : string ;
begin
   Result := SLVToStr( Bits[ Cursor, Index ] ) ;
end ;

function TSLVSignal.Accept( Visitor : TSLVVisitor ) : TObject ;
begin
   Result := Visitor.Visit( Self ) ;
end ;

function TSLVSignal.GetLeft : Integer ;
begin
   Result := fBits.fOut ;
end ;

function TSLVSignal.GetRight : Integer ;
begin
   Result := fBits.fIn - 1 ;
end ;

//procedure TSLVSignal.Add( const aSignal : TSignal ) ;
//var
//   p : PSLVArray ;
//begin
//   if fWidth <> 1 then
//      raise EBitsError.Create( 'TSLVSignal.Add: Width <> 1' ) ;
//
//   p := fBits.Add( fWidth ) ;
//   p^[ 0 ] := aSignal.State ;
//end ;

procedure TSLVSignal.Add( const aValue : array of TSLVType ) ;
var
   i : integer ;
   p : PSLVArray ;
begin
   if fWidth <> length( aValue ) then
      raise EBitsError.Create( 'TSLVSignal.Add: Width mismatch' ) ;

   p := fBits.Add( fWidth ) ;
   for i := 0 to fWidth - 1 do
      p^[ i ] := aValue[ i ] ;
end ;

//procedure TSLVSignal.Add( const aVector : TVector ) ;
//var
//   i : integer ;
//   p : PSLVArray ;
//begin
//   if fWidth <> aVector.SignalList.Count then
//      raise EBitsError.Create( 'TSLVSignal.Add: Width mismatch' ) ;
//
//   p := fBits.Add( fWidth ) ;
//   for i := 0 to fWidth - 1 do
//      p^[ i ] := aVector.SignalList[ i ].State ;
//end ;

function TSLVSignal.GetCapacity : integer ;
begin
   Result := fBits.Capacity ;
end ;

procedure TSLVSignal.SetCapacity( const Value : integer ) ;
begin
   fBits.Capacity := Value ;
end ;

procedure TSLVSignal.Acquire ;
begin
end ;

function TSLVSignal.GetName : string ;
begin
   Result := '' ;
//   if assigned( fLink ) then
//      Result := Idents[ fLink.Inst ] ;
end ;

function TSLVSignal.GetPath : string ;
begin
   Result := '' ;
//   if assigned( fLink ) and assigned( fLink.Path ) then
//      Result := fLink.Path.AsString ;
end ;

{ TSLVBundle }

function TSLVBundle.Accept( Visitor : TSLVVisitor ) : TObject ;
begin
   Result := Visitor.Visit( Self ) ;
end ;

procedure TSLVBundle.Acquire ;
var
   i : integer ;
begin
   for i := 0 to fSignals.Count - 1 do
      TSLVSignal( fSignals[ i ] ).Acquire ;
end ;

function TSLVBundle.Add( aWidth : integer ) : TSLVSignal ;
begin
   Result := TSLVSignal.Create( aWidth ) ;
   AddSignal( Result ) ;
end ;

procedure TSLVBundle.AddSignal( signal : TSLVSignal ) ;
begin
   fSignals.Add( signal ) ;
end ;

procedure TSLVBundle.Clear ;
begin
   fName := '' ;
   fSignals.Clear ;
end ;

constructor TSLVBundle.Create ;
begin
   fSignals := TObjectList.Create ;
end ;

destructor TSLVBundle.Destroy ;
begin
   fSignals.Free ;
   inherited ;
end ;

function TSLVBundle.GetCapacity : integer ;
begin
   Result := 0 ;
   if Count > 0 then
      Result := Signals[ 0 ].Capacity ;
end ;

function TSLVBundle.GetCount : Integer ;
begin
   Result := fSignals.Count ;
end ;

function TSLVBundle.GetLeft : Integer ;
begin
   Result := 0 ;
   if Count > 0 then
      Result := Signals[ 0 ].Oldest ;
end ;

function TSLVBundle.GetRight : Integer ;
begin
   Result := -1 ;
   if Count > 0 then
      Result := Signals[ 0 ].Newest ;
end ;

function TSLVBundle.GetSignal( Index : integer ) : TSLVSignal ;
begin
   Result := nil ;
   if Index < fSignals.Count then
      Result := TSLVSignal( fSignals[ Index ] ) ;
end ;

function TSLVBundle.GetSpan : DWORD ;
begin
   Result := Newest - Oldest + 1 ;
end ;

procedure TSLVBundle.Reset ;
var
   i : integer ;
begin
   for i := 0 to fSignals.Count - 1 do
      TSLVSignal( fSignals[ i ] ).Reset ;
end ;

procedure TSLVBundle.SetCapacity( const Value : integer ) ;
var
   i : integer ;
begin
   for i := 0 to fSignals.Count - 1 do
      TSLVSignal( fSignals[ i ] ).Capacity := Value ;
end ;

procedure TSLVBundle.SetSignal( Index : integer ; const Value : TSLVSignal ) ;
begin
   fSignals[ Index ] := Value ;
end ;

{ TQueue }

constructor TQueue.Create( aWidth : integer ) ;
begin
   fItems := nil ;
   fWidth := aWidth ;
end ;

destructor TQueue.Destroy ;
var
   i : integer ;
begin
   for i := 0 to fCapacity - 1 do
      FreeMem( fItems[ i ] ) ;
   fItems := nil ;
   inherited ;
end ;

procedure TQueue.Clear ;
begin
   fIn := 0 ;
   fOut := 0 ;
end ;

procedure TQueue.SetCapacity( const Value : integer ) ;
var
   i : integer ;
begin
   for i := 0 to fCapacity - 1 do
      FreeMem( fItems[ i ] ) ;
   fItems := nil ;
   fCapacity := Value ;
   Setlength( fItems, fCapacity ) ;
   for i := 0 to fCapacity - 1 do
      GetMem( fItems[ i ], fWidth ) ;
end ;

function TQueue.GetCapacity : integer ;
begin
   Result := fCapacity ;
end ;

function TQueue.GetItems( index : integer ) : PSLVArray ;
begin
   Result := fItems[ index mod fCapacity ] ;
end ;

function TQueue.Add( aWidth : integer ) : PSLVArray ;
begin
   Result := fItems[ fIn mod fCapacity ] ;
   inc( fIn ) ;
   if fIn >= fOut + fCapacity then
      inc( fOut ) ;
end ;

function TQueue.GetCount : integer ;
begin
   Result := ( fIn - fOut + fCapacity ) mod fCapacity ;
end ;

initialization

finalization

end.

